home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / xlibpas2.zip / XBM2.PAS < prev    next >
Pascal/Delphi Source File  |  1994-06-10  |  13KB  |  392 lines
  1. {╔══════════════════════════════════════════════════════════════════════════╗
  2.  ║                                                                          ║
  3.  ║                     XBM v2.0 for BORLAND PASCAL 7.0                      ║
  4.  ║                                                                          ║
  5.  ╠══════════════════════════════════════════════════════════════════════════╣
  6.  ║                                                                          ║
  7.  ║                       Original version written by                        ║
  8.  ║      Themie Gouthas  (egg@dstos3.dsto.gov.au / teg@bart.dsto.gov.au)     ║
  9.  ║                                                                          ║
  10.  ║                    Conversion to Borland Pascal by                       ║
  11.  ║                Tristan Tarrant (tristant@cogs.susx.ac.uk)                ║
  12.  ║                                                                          ║
  13.  ╚══════════════════════════════════════════════════════════════════════════╝}
  14.  
  15. {$A+,B-,E-,G+,I+,N-,O-,P-,Q-,S-,T-,X+}
  16.  
  17. {$IFDEF DPMI}
  18. {$C FIXED PRELOAD PERMANENT}
  19. {$ENDIF}
  20.  
  21. Unit Xbm2;
  22.  
  23. Interface
  24.  
  25. Uses Xlib2;
  26.  
  27. Procedure XPbmToBm( var source, dest );
  28. Procedure XBmToPbm( var source, dest );
  29. Procedure XPutMaskedPbm( X, Y,ScrnOffs : word; var Bitmap );
  30. Procedure XPutPbm( X,Y,ScrnOffs:word; var Bitmap );
  31. Procedure XGetPbm( X,Y: word;SrcWidth,SrcHeight:byte;
  32.                                      ScrnOffs:word; var Bitmap );
  33. Procedure XFlipMaskedPbm( X,Y,ScrnOffs:word; var Bitmap; Orientation:word );
  34. Procedure XFlipPbm( X,Y,ScrnOffs:word; var Bitmap; Orientation:word );
  35. Procedure XCompilePbm( LogicalWidth : word; var bitmap, output );
  36. Function  XSizeOfCPbm( logicalwidth : word; var bitmap ) : word;
  37. Procedure XCompileBitmap( logicalwidth:word; var bitmap, output );
  38. Function  XSizeOfCBitmap( logicalwidth:word; var bitmap ):word;
  39. Procedure XPutCBitmap( XPos,YPos,PageOffset:word; var Sprite );
  40. Procedure XPutMaskedPBMClipX( X, Y, ScrnOffs:word; var Bitmap );
  41. procedure XPutMaskedPBMClipY( X, Y, ScrnOffs:word; var Bitmap );
  42. Procedure XPutMaskedPBMClipXY( X, Y, ScrnOffs:word; var Bitmap );
  43. Procedure XPutPBMClipX( X, Y, ScrnOffs:word; var Bitmap );
  44. Procedure XPutPBMClipY( X, Y, ScrnOffs : word; var Bitmap );
  45. Procedure XPutPBMClipXY( X, Y, ScrnOffs:word; var Bitmap );
  46. Procedure XStoreVBMImage( VramOffs,Align:word; var LBitmap );
  47. Procedure XPutMaskedVBM( X, Y, ScrnOffs:word; var SrcVBM );
  48. Procedure XPutMaskedVBMClipX( X, Y, ScrnOffs:word; var SrcVBM );
  49. Procedure XPutMaskedVBMClipY( X, Y, ScrnOffs : word; var SrcVBM );
  50. Procedure XPutMaskedVBMClipXY( X, Y, ScrnOffs:word; var SrcVBM );
  51. Function  XMakeVBM( var lbm; var VramStart : word ) : PAlignmentHeader;
  52. Function  Xsizeofcbitmap32(logicalscreenwidth : word; var bitmapin ) : word;
  53. Function  Xcompilebitmap32(logicalscreenwidth : word; var bitmapin, bitmapout ) : word;
  54. Procedure XScale( DestX, DestY, DestWidth, DestHeight, ScrnOffs : word; var Bitmap );
  55. Procedure XMaskedScale( DestX, DestY, DestWidth, DestHeight, ScrnOffs : word; var Bitmap );
  56.  
  57. Implementation
  58. {$IFDEF DPMI}
  59. {$L XBM2.OBP}
  60. {$ELSE}
  61. {$L XBM2.OBJ}
  62. {$ENDIF}
  63. Procedure XPbmToBm( var source, dest ); external;
  64. Procedure XBmToPbm( var source, dest ); external;
  65. Procedure XPutMaskedPbm( X, Y,ScrnOffs : word; var Bitmap ); external;
  66. Procedure XPutPbm( X,Y,ScrnOffs:word; var Bitmap ); external;
  67. Procedure XGetPbm( X,Y: word;SrcWidth,SrcHeight:byte;
  68.                                      ScrnOffs:word; var Bitmap ); external;
  69. Procedure XFlipMaskedPbm( X,Y,ScrnOffs:word; var Bitmap; Orientation:word ); external;
  70. Procedure XFlipPbm( X,Y,ScrnOffs:word; var Bitmap; Orientation:word ); external;
  71. Procedure XCompilePbm( LogicalWidth : word; var bitmap, output ); external;
  72. Function  XSizeOfCPbm( logicalwidth : word; var bitmap ) : word; external;
  73. Procedure XCompileBitmap( logicalwidth:word; var bitmap, output ); external;
  74. Function  XSizeOfCBitmap( logicalwidth:word; var bitmap ):word; external;
  75. Procedure XPutCBitmap( XPos,YPos,PageOffset:word; var Sprite ); external;
  76. Procedure XPutMaskedPBMClipX( X, Y, ScrnOffs:word; var Bitmap ); external;
  77. procedure XPutMaskedPBMClipY( X, Y, ScrnOffs:word; var Bitmap ); external;
  78. Procedure XPutMaskedPBMClipXY( X, Y, ScrnOffs:word; var Bitmap ); external;
  79. Procedure XPutPBMClipX( X, Y, ScrnOffs:word; var Bitmap ); external;
  80. Procedure XPutPBMClipY( X, Y, ScrnOffs : word; var Bitmap ); external;
  81. Procedure XPutPBMClipXY( X, Y, ScrnOffs:word; var Bitmap ); external;
  82. Procedure XStoreVBMImage( VramOffs,Align:word; var LBitmap ); external;
  83. Procedure XPutMaskedVBM( X, Y, ScrnOffs:word; var SrcVBM ); external;
  84. Procedure XPutMaskedVBMClipX( X, Y, ScrnOffs:word; var SrcVBM ); external;
  85. Procedure XPutMaskedVBMClipY( X, Y, ScrnOffs : word; var SrcVBM ); external;
  86. Procedure XPutMaskedVBMClipXY( X, Y, ScrnOffs:word; var SrcVBM ); external;
  87. Procedure XScale( DestX, DestY, DestWidth, DestHeight, ScrnOffs : word; var Bitmap ); external;
  88. Procedure XMaskedScale( DestX, DestY, DestWidth, DestHeight, ScrnOffs : word; var Bitmap ); external;
  89.  
  90. function XMakeVBM( var lbm; var VramStart : word ) : PAlignmentHeader;
  91. var
  92.     LBMHeadr : ^LBMheader;
  93.     VBMHeadr : PAlignmentHeader;
  94.     VBMMaskPtr, p, LBMPixelPtr : ^byte;
  95.     align,BitNum,TempImageWidth, scanline : integer;
  96.     TempWidth,TempHeight,TempSize,MaskSize,VramOffs,MaskSpace : word;
  97.     MaskTemp : byte;
  98. begin
  99.     VramOffs := VramStart;
  100.     LBMHeadr := @lbm;
  101.     TempWidth  := (LBMHeadr^.width+3) div 4+1;
  102.     TempHeight := LBMHeadr^.height;
  103.     TempSize   := TempWidth*TempHeight;
  104.     getmem( VBMHeadr,22+TempSize*4);
  105.     MaskSpace:=22;
  106.     VBMHeadr^.ImageWidth  := TempWidth;
  107.     VBMHeadr^.ImageHeight := TempHeight;
  108.     VBMHeadr^.size := 22+TempSize*4;
  109.     for align := 0 to 3 do
  110.     begin
  111.         VBMHeadr^.alignments[align].ImagePtr := VramOffs;
  112.         XStoreVBMImage(VramOffs,align,lbm);
  113.         MaskSpace := MaskSpace+TempSize;
  114.         VramOffs := VramOffs+TempSize;
  115.     end;
  116.     VBMMaskPtr := ptr(Seg(VBMHeadr^),Ofs(VBMHeadr^)+22);
  117.     for align:=0 to 3 do
  118.     begin
  119.         LBMPixelPtr := ptr(Seg(lbm),Ofs(lbm)+ 2);
  120.         VBMHeadr^.alignments[align].MaskPtr := Ofs(VBMMaskPtr^);
  121.         for scanline := 0 to TempHeight-1 do
  122.         begin
  123.             BitNum := align;
  124.             MaskTemp := 0;
  125.             TempImageWidth := LBMHeadr^.width;
  126.             repeat
  127.                 MaskTemp := MaskTemp or (Ord(LBMPixelPtr^<>0) shl BitNum);
  128.                 LBMPixelPtr := Ptr(Seg(LBMPixelPtr^),Ofs(LBMPixelPtr^)+1);
  129.                 inc(BitNum);
  130.                 if BitNum > 3 then
  131.                 begin
  132.                     VBMMaskPtr^ := MaskTemp;
  133.                     VBMMaskPtr := Ptr(Seg(VBMMaskPtr^),Ofs(VBMMaskPtr^)+1);
  134.                     MaskTemp := 0;
  135.                     BitNum := 0;
  136.                 end;
  137.                 dec(TempImageWidth);
  138.             until TempImageWidth=0;
  139.             if BitNum<>0 then VBMMaskPtr^ := MaskTemp else VBMMaskPtr^ := 0;
  140.             VBMMaskPtr := Ptr(Seg(VBMMaskPtr^),Ofs(VBMMaskPtr^)+1);
  141.         end;
  142.     end;
  143.     VramStart :=VramOffs;
  144.     XMakeVBM := VBMHeadr;
  145. end;
  146.  
  147. Const
  148.     ROLAL = $c0d0;
  149.     SHORTSTORE8  = $44c6;
  150.     STORE8       = $84c6;
  151.     SHORTSTORE16 = $44c7;
  152.     STORE16      = $84c7;
  153.     ADCSIIMMED   = $d683;
  154.     OUTAL        = $ee;
  155.     RETURN       = $cb;
  156.     DWORDPREFIX  = $66;
  157.  
  158. Function xcompilebitmap32(logicalscreenwidth : word; var bitmapin, bitmapout ) : word;
  159. type
  160.     ByteArray = array[0..1] of byte;
  161. var
  162.     height, column, setcolumn, scanx, scany, outputused, width, margin,
  163.     margin2, margin4, pix0, pix1, pix2, pix3, numpix : integer;
  164.     pos : integer;
  165.     bitmap : ByteArray absolute bitmapin;
  166.     output : ByteArray absolute bitmapout;
  167.  
  168. begin
  169.     column := 0;
  170.     setcolumn := 0;
  171.     scanx := 0;
  172.     scany := 0;
  173.     outputused := 0;
  174.     width := bitmap[0];
  175.     height := bitmap[1];
  176.  
  177.     margin := width - 1;
  178.     margin2 := margin - 4;
  179.     margin4 := margin - 12;
  180.  
  181.     while (column < 4) do
  182.     begin
  183.         numpix := 1;
  184.         pix0 := bitmap[scany*width+scanx+2];
  185.         if pix0 <> 0 then
  186.         begin
  187.             if setcolumn <> column then
  188.             begin
  189.                 repeat
  190.                     output[outputused]:=ROLAL and 255;
  191.                     output[outputused+1]:=ROLAL shr 8;
  192.                     inc(outputused,2);
  193.                     output[outputused]:=ADCSIIMMED and 255;
  194.                     output[outputused+1]:=ADCSIIMMED shr 8;
  195.                     inc(outputused,2);
  196.                     output[outputused] := 0;
  197.                     inc(outputused);
  198.                     inc(setcolumn);
  199.                 until setcolumn = column;
  200.                 output[outputused] := OUTAL;
  201.                 inc(outputused);
  202.             end;
  203.             if scanx <= marg